-- Haskore Live!
--
-- David Siegel <djsiegel@seas.upenn.edu>
-- Jonathan Coveney <jcoveney@wharton.upenn.edu>
--
-- Routine.hs
--

-- | A 'Routine m' is a named command with a description, and maybe usage
-- information. It also provides a RoutineF, a function on some monad. It
-- generalizes the idea of a command invoked by a user.
module Routine ( T (..), RoutineF, Argv
               , Name, Description, Usage
               , lookup, lookupF
               , zeroRoutine, zeroRoutineF
               , runTests
               ) where

import Test.HUnit
import Prelude hiding (lookup)
import Data.Maybe (isJust, isNothing)

-- | Routine name.
type Name        = String
-- | Routine description.
type Description = String
-- | Routine usage.
type Usage       = String

-- | Arguments to a RoutineF.
type Argv        = [String]

-- | A Routine function. Performs the routine on some monad.
type RoutineF m = Argv -> m ()

-- | A 'Routine.T' is a generic, named command that can be performed.  It has a
-- Name, a Description, optionally Usage information, and a function to perform
-- on some monad.
data T m = T Name Description (Maybe Usage) (RoutineF m)

------------------------------------------------------------
-- Public method definitions
------------------------------------------------------------

instance Show (T m) where
    show (T c d Nothing _)  = concat [c, " - ", d, ":\n", "  > ", c, "\n"]
    show (T c d (Just u) _) = concat [c, " - ", d, ":\n", "  > ", u, "\n"]

-- | An empty Routine. Can be used for testing.
zeroRoutine :: T IO
zeroRoutine = T "" "" Nothing zeroRoutineF

-- | An empty RoutineF. Can be used for testing.
zeroRoutineF :: Argv -> IO ()
zeroRoutineF _ = return ()

-- | Given a routine name, looks for a routine by that name.
lookup :: Name -> [T m] -> Maybe (T m)
lookup n rs = case filter (\(T n' _ _ _) -> n == n') rs of
    [r] -> Just r
    _   -> Nothing

testLookup = TestCase $ do
    assertBool "lookup - found" (isJust found)
    assertBool "lookup - not found" (isNothing notFound)
    where rs       = [zeroRoutine]
          found    = lookup "" rs
          notFound = lookup "foo" rs

-- | Given a routine name, looks for a RoutineF of a routine by that name.
lookupF :: Name -> [T m] -> Maybe (RoutineF m)
lookupF n rs = case lookup n rs of
    Just (T _ _ _ f) -> Just f
    _                -> Nothing

testLookupF = TestCase $ do
    assertBool "lookupF - found" (isJust found)
    assertBool "lookupF - not found" (isNothing notFound)
    where rs       = [zeroRoutine]
          found    = lookupF "" rs
          notFound = lookupF "foo" rs

-- | Runs unit tests.
runTests = runTestTT $
    TestList [ TestLabel "testLookup" testLookup
             , TestLabel "testLookupF" testLookupF
             ]
